Graphics Plus/Graphics Plus.iso/libs/tsipp/tsipp.lha/tsipp3.0a/tests/obj.test

Text File | 1992-11-02 | 11.7 KB | 531 lines

#==============================================================================
#                                  obj.test
#------------------------------------------------------------------------------
# Test of the Tcl SIPP object commands.
#------------------------------------------------------------------------------
# Copyright 1992 Mark Diekhans
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Mark Diekhans makes
# no representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#------------------------------------------------------------------------------
# $Id: obj.test,v 2.0 1992/11/02 03:55:56 markd Rel $
#==============================================================================

if {[info procs test] == ""} {source testprocs.tcl}

#
# Returns a list of two surfaces.
#
proc Cube {} {
    set shader [SippShaderBasic .6 .1 .4 {.8 .5 .2}]
    SippPolygonPush {{-1  1  1} { 1  1  1} { 1  1 -1} {-1  1 -1}}
    SippPolygonPush {{-1 -1 -1} { 1 -1 -1} { 1 -1  1} {-1 -1  1}}
    SippPolygonPush {{-1  1  1} {-1 -1  1} { 1 -1  1} { 1  1  1}}
    lappend surfaceList [SippSurfaceCreate $shader]
    SippShaderDelete $shader

    set shader [SippShaderBasic .6 .1 .4 {.8 .2 .5}]
    SippPolygonPush {{ 1  1  1} { 1 -1  1} { 1 -1 -1} { 1  1 -1}}
    SippPolygonPush {{ 1  1 -1} { 1 -1 -1} {-1 -1 -1} {-1  1 -1}}
    SippPolygonPush {{-1  1 -1} {-1 -1 -1} {-1 -1  1} {-1  1  1}}
    lappend surfaceList [SippSurfaceCreate $shader]
    SippShaderDelete $shader

    return $surfaceList
}

#
# Creates an object with the Cube surfaces
#
proc CubeObj {} {
    set surfList [Cube]
    set objHdl [SippObjectCreate]
    SippObjectAddSurface $objHdl $surfList
    SippSurfaceDelete $surfList
    return $objHdl
}

#
# Test SippObjectCreate command.
#

test {object-1.1} {
    SippObjectCreate  XXX
} 1 {wrong # args: SippObjectCreate}

test {object-1.2} {
    set object1 [SippObjectCreate]
    set object2 [SippObjectCreate]
    list [crange $object1 0 5] [crange $object2 0 5] \
         [expr {"$object1"=="$object2"}]
} 0 {object object 0}

#
# Test SippObjectDelete command.
#

test {object-2.1} {
    SippObjectDelete XXX
} 1 {invalid object handle: XXX}

test {object-2.2} {
    SippObjectDelete
} 1 {wrong # args: SippObjectDelete objectlist}

test {object-2.3} {
    set objList {}
    for {set idx  0} {$idx < 75} {incr idx} {
        lappend objList [SippObjectCreate]
    }
    SippObjectDelete $objList
} 0 {}

#
# Test SippObjectInstance command.
#

test {object-3.1} {
    SippObjectInstance XXX
} 1 {invalid object handle: XXX}

test {object-3.2} {
    SippObjectInstance
} 1 {wrong # args: SippObjectInstance objecthandle}

test {object-3.3} {
    catch {unset objectx1}; catch {unset objectx2}
    set objectx1 [CubeObj]
    set objectx2 [SippObjectInstance $objectx1]
    SippObjectDelete [list $objectx1 $objectx2]
    crange $objectx2 0 5
} 0 {object}

#
# Test SippObjectDup command.
#

test {object-4.1} {
    SippObjectDup XXX
} 1 {invalid object handle: XXX}

test {object-4.2} {
    SippObjectDup
} 1 {wrong # args: SippObjectDup objecthandle}

test {object-4.3} {
    catch {unset objectx1}; catch {unset objectx2}
    set objectx1 [CubeObj]
    set objectx2 [SippObjectDup $objectx1]
    SippObjectDelete [list $objectx1 $objectx2]
    crange $objectx2 0 5
} 0 {object}

#
# Test SippObjectDeepDup command.
#

test {object-5.1} {
    SippObjectDeepDup XXX
} 1 {invalid object handle: XXX}

test {object-5.2} {
    SippObjectDeepDup
} 1 {wrong # args: SippObjectDeepDup objecthandle}

test {object-5.3} {
    catch {unset objectx1}; catch {unset objectx2}
    set objectx1 [CubeObj]
    set objectx2 [SippObjectDeepDup $objectx1]
    SippObjectDelete [list $objectx1 $objectx2]
    crange $objectx2 0 5
} 0 {object}

#
# Test SippObjectClearTransf command.
#

test {object-6.1} {
    SippObjectClearTransf XXX
} 1 {invalid object handle: XXX}

test {object-6.2} {
    SippObjectClearTransf
} 1 {wrong # args: SippObjectClearTransf objectlist}

test {object-6.3} {
    SippObjectSetTransf $object1 $testMat2
    SippObjectClearTransf $object1
    SippObjectGetTransf $object1
} 0 $identityMat

#
# Test SippObjectGetTransf commands.
#

test {object-7.1} {
    SippObjectGetTransf XXX
} 1 {invalid object handle: XXX}

test {object-7.2} {
    SippObjectGetTransf
} 1 {wrong # args: SippObjectGetTransf objecthandle}

test {object-7.3} {
    SippObjectClearTransf $object1
    SippObjectGetTransf $object1
} 0 $identityMat

test {object-7.4} {
    SippObjectClearTransf $object1
    SippObjectSetTransf $object1 $testMat1
    SippObjectGetTransf $object1
} 0 $testMat1


#
# Test SippObjectSetTransf command
#

test {object-8.1} {
    SippObjectSetTransf  YYY $testMat1
} 1 {invalid object handle: YYY}

test {object-8.2} {
    SippObjectSetTransf
} 1 {wrong # args: SippObjectSetTransf objectlist matrix}

test {object-8.3} {
    SippObjectClearTransf $object1
    SippObjectSetTransf $object1 $testMat1
    SippObjectSetTransf $object1 $testMat2
    SippObjectGetTransf $object1
} 0 $testMat2

#
# Test SippObjectTransform command.
#

test {object-9.1} {
    SippObjectTransform XXX $testMat1
} 1 {invalid object handle: XXX}

test {object-9.2} {
    SippObjectTransform
} 1 {wrong # args: SippObjectTransform objectlist matrix}

test {object-9.3} {
    SippObjectClearTransf $object1
    SippObjectTransform $object1 $testMat1
    SippObjectGetTransf $object1
} 0 $testMat1

#
# Test SippObjectAddSurface command.
#

test {object-10.1} {
    SippObjectAddSurface XXX YYY
} 1 {invalid object handle: XXX}

test {object-10.2} {
    SippObjectAddSurface
} 1 {wrong # args: SippObjectAddSurface objecthandle surfacelist}

test {object-10.3} {
    SippObjectAddSurface $object1 surfacex
} 1 {invalid surface handle: surfacex}

test {object-10.4} {
    set surfList [Cube]
    SippObjectAddSurface $object1 $surfList
    SippSurfaceDelete $surfList
} 0 {}

#
# Test SippObjectSubSurface commands.
#

test {object-11.1} {
    SippObjectSubSurface XXX YYY
} 1 {invalid object handle: XXX}

test {object-11.2} {
    SippObjectSubSurface
} 1 {wrong # args: SippObjectSubSurface objecthandle surfacelist}

test {object-11.3} {
    SippObjectSubSurface $object1 surfacex
} 1 {invalid surface handle: surfacex}

test {object-11.4} {
    set surfList [Cube]
    SippObjectAddSurface $object1 $surfList
    SippObjectSubSurface $object1 $surfList
    SippSurfaceDelete $surfList
} 0 {}

#
# Test SippObjectAddSubobj command.
#

test {object-12.1} {
    SippObjectAddSubobj XXX YYY
} 1 {invalid object handle: XXX}

test {object-12.2} {
    SippObjectAddSubobj
} 1 {wrong # args: SippObjectAddSubobj objecthandle subobjlist}

test {object-12.3} {
    SippObjectAddSubobj $object1 objectx
} 1 {invalid object handle: objectx}

test {object-12.4} {
    set object2 [CubeObj]
    SippObjectAddSubobj $object1 $object2
    SippObjectDelete $object2
} 0 {}

test {object-12.5} {
    set object2 [CubeObj]
    set object3 [CubeObj]
    SippObjectAddSubobj $object1 [list $object2 $object3]
    SippObjectDelete [list $object2 $object3]
} 0 {}

#
# Test SippObjectSubSubobj command.
#

test {object-13.1} {
    SippObjectSubSubobj XXX YYY
} 1 {invalid object handle: XXX}

test {object-13.2} {
    SippObjectSubSubobj
} 1 {wrong # args: SippObjectSubSubobj objecthandle subobjlist}

test {object-13.3} {
    SippObjectSubSubobj $object1 objectx
} 1 {invalid object handle: objectx}

test {object-13.4} {
    set object2 [CubeObj]
    SippObjectAddSubobj $object1 $object2
    SippObjectSubSubobj $object1 $object2
    SippObjectDelete $object2
} 0 {}

test {object-13.5} {
    set object2 [CubeObj]
    set object3 [CubeObj]
    SippObjectAddSubobj $object1 [list $object2 $object3]
    SippObjectSubSubobj $object1 [list $object2 $object3]
    SippObjectDelete [list $object2 $object3]
} 0 {}

#
# Test SippObjectRotateX command.
#

test {object-14.1} {
    SippObjectRotateX XXX 1
} 1 {invalid object handle: XXX}

test {object-14.2} {
    SippObjectRotateX
} 1 {wrong # args: SippObjectRotateX object angle}

test {object-14.3} {
    SippObjectRotateX $object1 aa
} 1 {expected floating-point number but got "aa"}

test {object-14.4} {
    SippObjectRotateX $object1 10
} 0 {}

test {object-14.5} {
    SippObjectRotateX $object1 R10
} 0 {}

test {object-14.6} {
    SippObjectRotateX $object1 D10
} 0 {}

#
# Test SippObjectRotateX command.
#

test {object-15.1} {
    SippObjectRotateX XXX 1
} 1 {invalid object handle: XXX}

test {object-15.2} {
    SippObjectRotateX
} 1 {wrong # args: SippObjectRotateX object angle}

test {object-15.3} {
    SippObjectRotateX $object1 aa
} 1 {expected floating-point number but got "aa"}

test {object-15.4} {
    SippObjectRotateX $object1 10
} 0 {}

test {object-15.5} {
    SippObjectRotateX $object1 R10
} 0 {}

test {object-15.6} {
    SippObjectRotateX $object1 D10
} 0 {}

#
# Test SippObjectRotateY command.
#

test {object-16.1} {
    SippObjectRotateY XXX 1
} 1 {invalid object handle: XXX}

test {object-16.2} {
    SippObjectRotateY
} 1 {wrong # args: SippObjectRotateY object angle}

test {object-16.3} {
    SippObjectRotateY $object1 aa
} 1 {expected floating-point number but got "aa"}

test {object-16.4} {
    SippObjectRotateY $object1 10
} 0 {}

test {object-16.5} {
    SippObjectRotateY $object1 R10
} 0 {}

test {object-16.6} {
    SippObjectRotateY $object1 D10
} 0 {}

#
# Test SippObjectRotateZ command.
#

test {object-17.1} {
    SippObjectRotateZ XXX 1
} 1 {invalid object handle: XXX}

test {object-17.2} {
    SippObjectRotateZ
} 1 {wrong # args: SippObjectRotateZ object angle}

test {object-17.3} {
    SippObjectRotateZ $object1 aa
} 1 {expected floating-point number but got "aa"}

test {object-17.4} {
    SippObjectRotateZ $object1 10
} 0 {}

test {object-17.5} {
    SippObjectRotateZ $object1 R10
} 0 {}

test {object-17.6} {
    SippObjectRotateZ $object1 D10
} 0 {}


#
# Test SippObjectRotate command.
#

test {object-18.1} {
    SippObjectRotate XXX {1.1 2.2 3.3} {1.1 0.0 1.2} R10
} 1 {invalid object handle: XXX}

test {object-18.2} {
    SippObjectRotate
} 1 {wrong # args: SippObjectRotate objecthandle point vector angle}

test {object-18.3} {
    SippObjectRotate $object1 {1.x 2.2 3.3} {1.1 0.0 1.2} R10
} 1 {expected floating-point number but got "1.x"}

test {object-18.4} {
    SippObjectRotate $object1 {1.0 2.2 3.3} {1.1 0.0 1.2} X10
} 1 {expected floating-point number but got "X10"}

test {object-18.5} {
    SippObjectRotate $object1 {1.1 2.2 3.3} {1.1 x.x 1.2} R10
} 1 {expected floating-point number but got "x.x"}

test {object-18.6} {
    SippObjectRotate $object1 {1.1 2.2 3.3} {1.1 0.0 1.2} R10
} 0 {}

test {object-18.7} {
    SippObjectRotate $object1 {1.1 2.2 3.3} {1.1 0.0 1.2} D100
} 0 {}

test {object-18.8} {
    SippObjectRotate $object1 {1.1 2.2 3.3} {1.1 0.0 1.2} 98
} 0 {}

#
# Test SippObjectScale command.
#

test {object-19.1} {
    SippObjectScale XXX 10
} 1 {invalid object handle: XXX}

test {object-19.2} {
    SippObjectScale
} 1 {wrong # args: SippObjectScale objecthandle factor|{xfactor yfactor zfactor}}

test {object-19.3} {
    SippObjectScale $object1 1x
} 1 {expected floating-point number but got "1x"}

test {object-19.4} {
    SippObjectScale $object1 10
} 0 {}

#
# Test SippObjectMove command.
#

test {object-20.1} {
    SippObjectMove XXX {1 2 3}
} 1 {invalid object handle: XXX}

test {object-20.2} {
    SippObjectMove
} 1 {wrong # args: SippObjectMove objecthandle {xdist ydist zdist}}

test {object-20.3} {
    SippObjectMove $object1 {1 x 3}
} 1 {expected floating-point number but got "x"}

test {object-20.4} {
    SippObjectMove $object1 {1 2 3}
} 0 {}

#
# Clean up...
#

test {object-21.1} {
    SippObjectDelete $object1
} 0 {}